
###########################
## Figure 4 (Appendix A) ##
###########################

library(dplyr)
library(ggplot2)

A_fun<-function(p,w=10){w-(p)^2}
HL<-function(p,t,alpha=1.25,I=10,w=10){I+(1-alpha)*A_fun(p,w) + log(t+1)}
HW<-function(p,t,alpha=1.25,I=10,w=10){I+alpha*A_fun(p,w) - t}

#These functions find the frontier values of t and p, meaning the values that give us the upper envelope of the HL-HW space
t_frontier<-function(alpha=1.25){
  alpha/(alpha-1) - 1
}

p_frontier<-function(K,I=10,alpha=1.25,w=10){
  val <- w-((-K+I+log(t_frontier(alpha)+1))/(alpha-1))
  
  ifelse(val>0,sqrt(val),0)
}

df2<-expand.grid(p=seq(0,sqrt(10),0.01),t=seq(0,5,0.01)) %>% 
  mutate(
    hw=HW(p,t),
    hl=HL(p,t)) %>% 
  filter(hl<=10) %>%
  mutate(hl_tile=ntile(hl,50)) %>%
  group_by(hl_tile) %>%
  mutate(
    hl_mean=mean(hl),
    hw_min=min(hw),
    hw_max=max(hw)) %>%
  ungroup() %>%
  arrange(hl) %>%
  mutate(hl_num=1:n())

set.plt<-data.frame(H_L=seq(7.5,10,0.05)) %>%
  mutate(H_W=HW(p=p_frontier(K=H_L),t=t_frontier())) %>%
  ggplot(aes(H_L,H_W))+
  geom_line(data=filter(df2,p %% 0.25==0 , t %% 0.25==0),aes(hl,hw,group=p),linetype="dotted",size=0.25)+geom_line(data=filter(df2,p %% 0.25==0 , t %% 0.25==0),aes(hl,hw,group=t),linetype="dashed",size=0.25)+
  geom_point(data=filter(df2,p %% 0.5==0,t %% 0.5==0),aes(hl,hw,color=p,fill=t),shape=21,size=1.5,stroke=1.5)+
  geom_abline(slope=1.25/(1-1.25),intercept =47.5+HW(p_frontier(K=9.5),t_frontier())) +
  #geom_point(data=filter(df2,p %% 0.25==0 , t %% 0.25==0,t==t_frontier()),aes(hl,hw),color="red")+
  #geom_line(color="red")+
  geom_abline(slope=1.25/(1-1.25),intercept = 60) +
  scale_fill_viridis_c(option="cividis")+
  scale_color_viridis_c(option="cividis")+
  theme_bw()+
  theme(legend.position="bottom")+
  labs(color="Policy Intervention (outer)",fill="Transfers (inner)")

set.plt
